home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cpp_libs / rwvector.lha / RWVector2.1 / src / mathpack / isamax.f < prev    next >
Encoding:
Text File  |  1989-08-17  |  2.7 KB  |  77 lines
  1. c   imsl routine name   - vbla=isamax                                   vbic0010
  2. c
  3. c-----------------------------------------------------------------------
  4. c
  5. c   computer            - vax/single
  6. c
  7. c   latest revision     - january 1, 1978
  8. c
  9. c   purpose             - find the smallest index of the maximum
  10. c                           magnitude of a single precision vector
  11. c
  12. c   usage               - function isamax (n,sx,incx)
  13. c
  14. c   arguments    isamax - the smallest index i such that abs(x(i))
  15. c                           is the maximum of abs(x(j)) for j=1 to n.
  16. c                           (output)
  17. c                           x(i) refers to a specific element of sx.
  18. c                           see incx argument description.
  19. c                n      - length of vector x. (input)
  20. c                sx     - real vector of length n*incx. (input)
  21. c                incx   - displacement between elements of sx. (input)
  22. c                           x(i) is defined to be sx(1+(i-1)*incx).
  23. c                           incx must be greater than zero.
  24. c
  25. c   precision/hardware  - single/all
  26. c
  27. c   reqd. imsl routines - none required
  28. c
  29. c   notation            - information on special notation and
  30. c                           conventions is available in the manual
  31. c                           introduction or through imsl routine uhelp
  32. c
  33. c   copyright           - 1978 by imsl, inc. all rights reserved.
  34. c
  35. c   warranty            - imsl warrants only that imsl testing has been
  36. c                           applied to this code. no other warranty,
  37. c                           expressed or implied, is applicable.
  38. c
  39. c-----------------------------------------------------------------------
  40. c
  41.       integer function isamax (n,sx,incx)
  42. c
  43. c                                  specifications for arguments
  44.       integer            n,incx
  45.       real               sx(1)
  46. c                                  specifications for local variables
  47.       integer            i,ii,ns
  48.       real               smax,xmag
  49. c                                  first executable statement
  50.       isamax = 0
  51.       if (n.le.0) return
  52.       isamax = 1
  53.       if (n.le.1) return
  54.       if (incx.eq.1) go to 15
  55. c                                  code for increments not equal to 1.
  56.       smax = abs(sx(1))
  57.       ns = n*incx
  58.       ii = 1
  59.       do 10 i=1,ns,incx
  60.          xmag = abs(sx(i))
  61.          if (xmag.le.smax) go to 5
  62.          isamax = ii
  63.          smax = xmag
  64.     5    ii = ii+1
  65.    10 continue
  66.       return
  67. c                                  code for increments equal to 1.
  68.    15 smax = abs(sx(1))
  69.       do 20 i=2,n
  70.          xmag = abs(sx(i))
  71.          if (xmag.le.smax) go to 20
  72.          isamax = i
  73.          smax = xmag
  74.    20 continue
  75.       return
  76.       end
  77.